{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-}
module Handler.MasterCatalog.DB where

import Foundation hiding (fieldView)
import Yesod.Json


import Data.Aeson.Types

import Data.Text                    ( Text, append, split )
import Data.Text.Read               ( rational )
import Handler.Types                ( Star(..), Ra, Dec )
import Handler.MasterCatalog.Object ( getObjects )

instance ToJSON Star where
  toJSON (Star r d m) = 
    object ["type" .= ("Feature" :: String)
           ,"properties" .= object ["mag"   .= m
                                   ,"coord" .= [r,d]]
           ,"geometry" .= object ["type" .= ("Point" :: String)
                                 ,"coordinates" .= [r,d]]
           ]
 
getMCDataBaseR :: Handler RepJson
getMCDataBaseR = do
  mbbox <- lookupGetParam "bbox"
  
  (ra,dec,r) <- case (parseBBox mbbox) of
    Nothing   -> invalidArgs ["Inavalid bbox"]
    Just bbox -> return bbox
    
  objs <- getObjects (const True) (ra,dec,r)
  jsonToRepJson $ object ["type"     .= ("FeatureCollection" :: String)
                         ,"features" .= toJSON objs]
  
--
parseBBox :: Maybe Text -> Maybe (Ra,Dec,Double)
parseBBox (Just bbox) =
  case (mapM (eitherToMaybe . rational) $ split (==',') bbox) of
    Just (ra:dec:r:_) -> Just $ fieldView (ra,dec,r)
    _                 -> Nothing
  where
    eitherToMaybe (Left _)  = Nothing
    eitherToMaybe (Right v) = Just $ fst v
    
parseBBox _ = Nothing

-- Из-за  проблемы с Q3C индексом в БД
-- Q3C - http://zeus.sai.msu.ru/~megera/wiki/SkyPixelization
fieldView :: (Ra,Dec,Double) ->  (Ra,Dec,Double)
fieldView (ra,dec,r) | ra < 0    = ( 360+ra, dec, r )
                     | otherwise = (     ra, dec, r )
    
